3.1 Missing Patterns

library(tidyverse)
library(extracat)

myTaxi <- read.csv(file="taxi_sample_2016.csv", header=TRUE, na.strings="M")

#delete first id column
myTaxi <- myTaxi[-1]
#visna(myTaxi)

We try to draw the visna graph, while the message showed that there is no missing pattern for the sample we drawed. In the next step, we will take a look at the univariate distributions of each feature, and see whether there are obvious outliers and significant patterns that may need additional attention.

3.2 Detailed Feature Distributions

dim(myTaxi)

## [1] 100000     19

names(myTaxi)

##  [1] "VendorID"              "tpep_pickup_datetime" 
##  [3] "tpep_dropoff_datetime" "passenger_count"      
##  [5] "trip_distance"         "pickup_longitude"     
##  [7] "pickup_latitude"       "RatecodeID"           
##  [9] "store_and_fwd_flag"    "dropoff_longitude"    
## [11] "dropoff_latitude"      "payment_type"         
## [13] "fare_amount"           "extra"                
## [15] "mta_tax"               "tip_amount"           
## [17] "tolls_amount"          "improvement_surcharge"
## [19] "total_amount"

For the given 19 features, we will plot their distribution according to whther it’s a categorical variable or a discrete variable.

Categorical: passenger_count, RatecodeID, store_and_fwd_flag, payment_type, extra, mta_tax, improvement_surcharge

Discrete: trip_distance, pickup_longitude, pickup_latitude, dropoff_longitude, dropoff_latitude, fare_amount, tip_amount, tolls_amount, total_amount

library(ggplot2)
library(ggpubr)
bar_1 <- ggplot(myTaxi, aes(VendorID))+geom_bar(fill="steelblue", width=0.5)
bar_2 <- ggplot(myTaxi, aes(passenger_count))+geom_bar(fill="steelblue", width=0.5)
bar_3 <- ggplot(myTaxi, aes(RatecodeID))+geom_bar(fill="steelblue", width=0.5)
bar_4 <- ggplot(myTaxi, aes(store_and_fwd_flag))+geom_bar(fill="steelblue", width=0.5)
bar_5 <- ggplot(myTaxi, aes(payment_type))+geom_bar(fill="steelblue", width=0.5)
bar_6 <- ggplot(myTaxi, aes(extra))+geom_bar(fill="steelblue", width=0.5)
bar_7 <- ggplot(myTaxi, aes(mta_tax))+geom_bar(fill="steelblue")
bar_8 <- ggplot(myTaxi, aes(improvement_surcharge))+geom_bar(fill="steelblue")

ggarrange(bar_1,bar_2,bar_3, bar_4, bar_5, bar_6, bar_7, bar_8, 
          ncol = 2, nrow = 4)

According to our first observation, for the categorical features, VendorID is well distributed; passanger_count has an obvious error term 0, and should be filtered; the RatecodeID has some obvious outlier on the right side; most of the store_and_fed_flag are in the ‘N’ categorical but shouldn’t be problematic; most of the payment_methods are method 1 or 2, also not a trouble for further EDAV and analysis; for the extra cost, there are some obvious error data located in -0.5 and -1; for the mta_tax, it’s also not possible for the amount to be <0; same for improvement_surcharge, the amount <0 should be filtered.

library(ggplot2)
library(ggpubr)
hist_1 <- ggplot(myTaxi, aes(trip_distance))+ geom_histogram(binwidth=10, fill="steelblue")
hist_2 <- ggplot(myTaxi, aes(pickup_longitude))+ geom_histogram(binwidth=10,fill="steelblue")
hist_3 <- ggplot(myTaxi, aes(pickup_latitude))+ geom_histogram(binwidth=10,fill="steelblue")
hist_4 <- ggplot(myTaxi, aes(dropoff_longitude))+ geom_histogram(binwidth=10,fill="steelblue")
hist_5 <- ggplot(myTaxi, aes(dropoff_latitude))+ geom_histogram(binwidth=10,fill="steelblue")
hist_6 <- ggplot(myTaxi, aes(fare_amount))+ geom_histogram(binwidth=10,fill="steelblue")
hist_7 <- ggplot(myTaxi, aes(tip_amount))+ geom_histogram(binwidth=10,fill="steelblue")
hist_8 <- ggplot(myTaxi, aes(tolls_amount))+ geom_histogram(binwidth=10,fill="steelblue")
hist_9 <- ggplot(myTaxi, aes(total_amount))+ geom_histogram(binwidth=10,fill="steelblue")

ggarrange(hist_1,hist_2,hist_3, hist_4, hist_5, hist_6, hist_7, hist_8, hist_9,
          ncol = 3, nrow = 3)

For the discrete features, there are some obvious outliers for the trip_distance; all the longtitude and latitude have some error data appeared as 0; for the fare_amount, error term <0 and too large outlier should be filtered; too large tip_amount, tolls_amount and total_amount should be filtered as well.

To have at least a taste of how the data distribution look like, we need to do a naive cut for the data. More detailed range will be selected and explained in the main analysis part. So far our choices are the followings:

• between(trip_distance, 0, 30)

• between(total_amount, 0, 300)

• improvement_surcharge >=0

• fare_amount < 105

• tolls_amount <=300

• tip_amount <= 100

• mta_tax >= 0

• extra>=0

• pickup_longtitude<0

• pickup_latitude>0

• dropoff_longtitude<0

• dropoff_latitude>0

• passenger_count>0

# a naive cut
myTaxi %>% filter(between(trip_distance, 0, 30),
                  between(total_amount, 0, 300),
                  improvement_surcharge >=0,
                  fare_amount<105,
                  tolls_amount <=300,
                  tip_amount <= 100,
                  mta_tax >= 0,
                  extra>=0,
                  pickup_longitude<0,
                  pickup_latitude>0,
                  dropoff_longitude<0,
                  dropoff_latitude>0,
                  passenger_count>0
                  ) -> myTaxi2

cat('This naive cut will delete',(1-nrow(myTaxi2)/nrow(myTaxi))*100,'% of total data.')

## This naive cut will delete 1.73 % of total data.

Till now, we can conclude from the sample data that the overall quality of the data is not bad, obvious erroneous data is less than 2%. But we are sure that this percentage is a result of a rough cut. A more detailed and well-defined filter range in the next session would greatly increase the erroneous data amout. Now, we go on with the distribution visualization.

bar_1 <- ggplot(myTaxi2, aes(VendorID))+geom_bar(fill="steelblue", width=0.5)
bar_2 <- ggplot(myTaxi2, aes(passenger_count))+geom_bar(fill="steelblue", width=0.5)
bar_3 <- ggplot(myTaxi2, aes(RatecodeID))+geom_bar(fill="steelblue", width=0.5)
bar_4 <- ggplot(myTaxi2, aes(store_and_fwd_flag))+geom_bar(fill="steelblue", width=0.5)
bar_5 <- ggplot(myTaxi2, aes(payment_type))+geom_bar(fill="steelblue", width=0.5)
bar_6 <- ggplot(myTaxi2, aes(extra))+geom_bar(fill="steelblue")
bar_7 <- ggplot(myTaxi2, aes(mta_tax))+geom_bar(fill="steelblue", width=0.1)
bar_8 <- ggplot(myTaxi2, aes(improvement_surcharge))+geom_bar(fill="steelblue", width=0.1)

ggarrange(bar_1,bar_2,bar_3, bar_4, bar_5, bar_6, bar_7, bar_8, 
          ncol = 2, nrow = 4)

hist_1 <- ggplot(myTaxi2, aes(trip_distance))+ geom_histogram(binwidth=2, fill="steelblue")
hist_2 <- ggplot(myTaxi2, aes(pickup_longitude))+ geom_histogram(binwidth=0.5,fill="steelblue")
hist_3 <- ggplot(myTaxi2, aes(pickup_latitude))+ geom_histogram(binwidth=0.5,fill="steelblue")
hist_4 <- ggplot(myTaxi2, aes(dropoff_longitude))+ geom_histogram(binwidth=0.5,fill="steelblue")
hist_5 <- ggplot(myTaxi2, aes(dropoff_latitude))+ geom_histogram(binwidth=0.5,fill="steelblue")
hist_6 <- ggplot(myTaxi2, aes(fare_amount))+ geom_histogram(binwidth=10,fill="steelblue")
hist_7 <- ggplot(myTaxi2, aes(tip_amount))+ geom_histogram(binwidth=10,fill="steelblue")
hist_8 <- ggplot(myTaxi2, aes(tolls_amount))+ geom_histogram(binwidth=10,fill="steelblue")
hist_9 <- ggplot(myTaxi2, aes(total_amount))+ geom_histogram(binwidth=10,fill="steelblue")

ggarrange(hist_1,hist_2,hist_3, hist_4, hist_5, hist_6, hist_7, hist_8, hist_9,
          ncol = 3, nrow = 3)

We can see through a naive cut, the data behave much better than before; however, a more detailed and well-rounded range need to be further developed for data analysis, this will lead to our main analysis step. For example, there are still outliers for tip amount and tolls amount, a more accurate range will be set for the longitude and latitude.

In short, except for some imbalance, the dataset’s quality seems to be good in general.

4.1 Data Cleaning Process

# install.packages('geosphere')
library(tidyverse)

df <-read_csv("taxi_sample_2016.csv", col_types = cols(X1 = col_skip()))
df %>% rename(pickup_datetime = tpep_pickup_datetime,
              dropoff_datetime = tpep_dropoff_datetime) -> df

# data cleaning

df %>% mutate (
  Duration = (dropoff_datetime - pickup_datetime) / 60,
  Average_speed = trip_distance / as.numeric(Duration / 60),
  Fare_rate = fare_amount / trip_distance,
  Euclidean_distance = 0.000621371192 *
    geosphere::distVincentyEllipsoid(p1 = df[, c('pickup_longitude', 'pickup_latitude')],
                                     p2 = df[, c('dropoff_longitude', 'dropoff_latitude')]),
  Winding_factor = trip_distance / Euclidean_distance) %>%
  filter(
  between(pickup_longitude, -74.052, -73.7443),
  between(pickup_latitude, 40.57, 40.877),
  between(trip_distance, 0, 30),
  between(fare_amount, 1, 105),
  between(Fare_rate, 1, 11),
  between(passenger_count, 0, 6),
  between(Duration, 2, 120),
  between(Euclidean_distance, 0, 15),
  between(Winding_factor, 0.95, 6),
  between(Average_speed, 3.1, 55),
  between(total_amount, 0, 300),
  improvement_surcharge >= 0,
  tolls_amount <= 300,
  tip_amount <= 100,
  mta_tax >= 0,
  extra >= 0,
  dropoff_longitude < 0,
  passenger_count > 0,
  RatecodeID <= 6
  ) -> clean_df

error_rate  <- 1 - dim(clean_df)[1] / dim(df)[1]
print(paste("Filtered erroneous data rate:", as.character(error_rate)))

## [1] "Filtered erroneous data rate: 0.08175"

dir.create(file.path('.', 'data'))
write_csv(clean_df, './data/clean_df.csv')

By looking at the univariate and joint distributions of variables, we found a few outliers. These outliers contains unreasonable values, including trips that fall in oceans, pickup locations far away from New York City, taxis that traveled negative distances, unreasonably expensive fares, trips with total distance shorter than the Euclidean distance from origin to destination and so on. These records are identified by looking at the visualised distributions, filtered out according to the selected range listed in table 2, and then marked as erroneous data. After applying the filter rules in table 2, we found around 13.4% erroneous data records.

Note: * are derived variables.

4.2 Cleaned Data Distribution Visual

After cleaning the data and adding the derived features, we repeat the distribution visualization process to check the thorough distribution. We still plot the graphs by categorical variables and descrete variables.

Categorical: passenger_count, RatecodeID, store_and_fwd_flag, payment_type, extra, mta_tax, improvement_surcharge

Discrete: trip_distance, pickup_longitude, pickup_latitude, dropoff_longitude, dropoff_latitude, fare_amount, tip_amount, tolls_amount, total_amount, Fare_rate, Duration, Euclidean_distance, Winding_factor, Average_speed

bar_1 <- ggplot(clean_df, aes(VendorID))+geom_bar(fill="steelblue", width=0.5)
bar_2 <- ggplot(clean_df, aes(passenger_count))+geom_bar(fill="steelblue", width=0.5)
bar_3 <- ggplot(clean_df, aes(RatecodeID))+geom_bar(fill="steelblue", width=0.5)
bar_4 <- ggplot(clean_df, aes(store_and_fwd_flag))+geom_bar(fill="steelblue", width=0.5)
bar_5 <- ggplot(clean_df, aes(payment_type))+geom_bar(fill="steelblue", width=0.5)
bar_6 <- ggplot(clean_df, aes(extra))+geom_bar(fill="steelblue")
bar_7 <- ggplot(clean_df, aes(mta_tax))+geom_bar(fill="steelblue", width=0.1)
bar_8 <- ggplot(clean_df, aes(improvement_surcharge))+geom_bar(fill="steelblue", width=0.01)

ggarrange(bar_1,bar_2,bar_3, bar_4, bar_5, bar_6, bar_7, bar_8, 
          ncol = 2, nrow = 4)

After the data cleaning, all categorical data appear to already exclude the outlier, especially for the improvement_surcharge, all data is 0.3; though the data has some imbalanced feature, it shouldn’t be too problematic.

hist_1 <- ggplot(clean_df, aes(trip_distance))+ geom_histogram(binwidth=2, fill="steelblue") + labs(y = "Frequency")
hist_2 <- ggplot(clean_df, aes(pickup_longitude))+ geom_histogram(binwidth=0.01,fill="steelblue")+ labs(y = "Frequency")
hist_3 <- ggplot(clean_df, aes(pickup_latitude))+ geom_histogram(binwidth=0.01,fill="steelblue")+ labs(y = "Frequency")
hist_4 <- ggplot(clean_df, aes(dropoff_longitude))+ geom_histogram(binwidth=0.01,fill="steelblue")+ labs(y = "Frequency")
hist_5 <- ggplot(clean_df, aes(dropoff_latitude))+ geom_histogram(binwidth=0.01,fill="steelblue")+ labs(y = "Frequency")
hist_6 <- ggplot(clean_df, aes(fare_amount))+ geom_histogram(binwidth=10,fill="steelblue")+ labs(y = "Frequency")
hist_7 <- ggplot(clean_df, aes(tip_amount))+ geom_histogram(binwidth=10,fill="steelblue")+ labs(y = "Frequency")
hist_8 <- ggplot(clean_df, aes(tolls_amount))+ geom_histogram(binwidth=10,fill="steelblue")+ labs(y = "Frequency")
hist_9 <- ggplot(clean_df, aes(total_amount))+ geom_histogram(binwidth=10,fill="steelblue")+ labs(y = "Frequency")

ggarrange(hist_1,hist_2,hist_3, hist_4, hist_5, hist_6, hist_7, hist_8, hist_9,
          ncol = 3, nrow = 3)

Aftter the cleaning, the discrete data also looks much nicer, among them pick_up longitude and latitude seems distribute more cloe than the drop-off ones, this makes sense because for taxis pick up guests in NYC, they do have some chances to drive far outside the city. For total_amount, some price over 100 make the distribution not that pretty, but still acceptable in reality. In the next step, we will move on take a look of the derived important features, those features should play a very important role in the later analysis, combined with our pick_up longotude, latitude and trip_distance. Let’s first take a look of the boxplot.

par(mar=c(10,4,4,4))
important <- c('trip_distance','Duration','Average_speed','Fare_rate','pickup_latitude','pickup_longitude','Winding_factor','Euclidean_distance')
important_df <- clean_df[,important]
boxplot(important_df, las=2)

The boxplot is not that much informative, since they have so different range and it’s meaningless to standardize those features. So histogram can be a better choice in this case.

The graph below shows our picked features, with a more careful picked binwidth.

hist_1 <- ggplot(clean_df, aes(x=trip_distance))+ geom_histogram(binwidth=0.2,  fill="steelblue") + labs(x = 'Trip distance (miles)', y = "Frequency")

hist_2 <- ggplot(clean_df, aes(Duration))+ geom_histogram(binwidth=0.5, fill="steelblue")+ labs(x = 'Trip duration (minutes)', y = "Frequency")

hist_3 <- ggplot(clean_df, aes(Average_speed))+ geom_histogram(binwidth=0.2, fill="steelblue")+ labs(x = 'Average speed (mph)', y = "Frequency")

hist_4 <- ggplot(clean_df, aes(Fare_rate))+ geom_histogram(binwidth=0.05, fill="steelblue")+ labs(x = 'Fare rate (USD/mile)', y = "Frequency")

hist_5 <- ggplot(clean_df, aes(pickup_latitude))+ geom_histogram(binwidth=0.002, fill="steelblue")+ labs(x = 'Latitude', y = "Frequency")

hist_6 <- ggplot(clean_df, aes(pickup_longitude))+ geom_histogram(binwidth=0.002, fill="steelblue")+ labs(x = 'Longitude', y = "Frequency")

hist_7 <- ggplot(clean_df, aes(Winding_factor))+ geom_histogram(binwidth=0.02, fill="steelblue")+ labs(x = 'Winding Factor', y = "Frequency")

hist_8 <- ggplot(clean_df, aes(Euclidean_distance))+ geom_histogram(binwidth=0.1, fill="steelblue")+ labs(x = 'Euclidean distance (miles)', y = "Frequency")

ggarrange(hist_1,hist_2,hist_3, hist_4, hist_5, hist_6, hist_7, hist_8, ncol = 2, nrow = 4)

At this step, we filtered, cleaned the data, derived some interesting features, visualized all the features independently and picked the most important features for further analysis. In next subsection, we will explore the travel patterns, both in the temporal dimension and spatial dimension.

4.3 Explore the Temporal-Spatial Taxi Travel Patterns in NYC

library('lubridate')
library(dplyr)
clean_df<-na.omit(clean_df)
clean_df$day<-strptime(clean_df$pickup_datetime, "%Y-%m-%d")
clean_df$weekday<-weekdays(clean_df$day)
pick_up=strptime(clean_df$pickup_datetime,"%Y-%m-%d %H:%M:%OS")
drop_off=strptime(clean_df$dropoff_datetime,"%Y-%m-%d %H:%M:%OS")
clean_df$duration=round(drop_off-pick_up,digits=0)
clean_df$hour=hour(clean_df$pickup_datetime)

clean_df$day<-as.character(clean_df$day)
clean_df %>%mutate(`day of week`=  factor(weekday, 
                  c('Monday','Tuesday','Wednesday','Thursday','Friday','Saturday','Sunday'))
                  ) -> clean_df
library(ggthemes)

g_1 <- ggplot(data=clean_df,
       aes(x=hour, y=Duration,color=`day of week`)) +
       stat_summary(fun.y = mean,geom="point",aes(shape=`day of week`))+
       stat_summary(fun.y = mean,geom="line",size=0.3)+
       ggtitle("(a) Average trip duration in 24 hours")+ 
       ylab("Average Duration (min)")+xlab("Hour of Day")+
       scale_color_brewer(type ='qual' )+
       scale_x_continuous(breaks = c(0:23) )

g_2 <- ggplot(data=clean_df,
       aes(x=hour, y=Euclidean_distance,color=`day of week`)) +
       stat_summary(fun.y = mean,geom="point",aes(shape=`day of week`))+
       stat_summary(fun.y = mean,geom="line",size=0.3)+
       ggtitle("(b) Average trip distance in 24 hours")+ 
       ylab("Average trip distance (miles)")+xlab("Hour of Day")+
       scale_color_brewer(type ='qual' )+
      scale_x_continuous(breaks = c(0:23))


g_3 <- ggplot(data=clean_df,
       aes(x=hour, y=Average_speed,color=`day of week`)) +
       stat_summary(fun.y = mean,geom="point",aes(shape=`day of week`))+
       stat_summary(fun.y = mean,geom="line",size=0.3)+
       ggtitle("(c) Average travel speed in 24 hours")+ 
       ylab("Average speed (mph)")+xlab("Hour of Day")+
       scale_color_brewer(type ='qual' )+
      scale_x_continuous(breaks = c(0:23))

clean_df %>% 
  group_by(day,hour)%>%
  summarise(sum_passenger_count=sum(passenger_count) ) %>%
  ungroup() -> temp4
temp4$day<-strptime(temp4$day, "%Y-%m-%d")
temp4$day_of_week<-weekdays(temp4$day)
temp4$day<-as.character(temp4$day)
temp4 %>% 
mutate(`day of week`=factor(day_of_week,
                          c('Monday','Tuesday','Wednesday','Thursday','Friday','Saturday','Sunday'),
                          ordered = TRUE),
       workday = if_else(`day of week`<'Saturday','weekdays','weekends'),
       workday = factor(workday)
      ) -> temp4 
g_4 <-temp4%>%
  group_by(`day of week`,hour) %>%
  summarise(avg_passenger_pickups=mean(sum_passenger_count))  %>%
  ggplot(aes(x=hour,y=avg_passenger_pickups,color=`day of week`))+
  geom_line(size=0.3)+
  geom_point(aes(shape=`day of week`),size=1)+
  ggtitle("(d) Hourly pikcked up person counts")+ 
  ylab("pickups (person per hour)")+xlab("Hour of Day")+
  scale_color_brewer(type ='qual' )+
  scale_x_continuous(breaks = c(0:23))

g_5 <-temp4%>%
  group_by(workday,hour) %>%
  summarise(avg_passenger_pickups=mean(sum_passenger_count))  %>%
  ggplot(aes(x=hour,y=avg_passenger_pickups,color=workday))+
  geom_line(size=0.8)+
  geom_point(aes(shape=workday),size=2)+
  ggtitle("(e) Hourly pikcked up person counts by weekdays and weekends")+ 
  ylab("pickups (person per hour)")+xlab("Hour of Day")+
  scale_color_discrete( )+
  scale_x_continuous(breaks = c(0:23))

ggarrange(g_1,g_2,g_3,g_4,g_5, nrow = 5)

Color Vision Deficiency

library("ggthemes")
g_5 <- g_1 + scale_colour_colorblind() 
g_6 <- g_2 + scale_colour_colorblind() 
g_7 <- g_3 + scale_colour_colorblind() 
g_8 <- g_4 + scale_colour_colorblind() 
ggarrange(g_5,g_6,g_7,g_8, ncol = 2, nrow = 2,
          common.legend = TRUE,legend = "bottom")

After exploring all the data, the results for average duration, trip distance, trip speed, and number of person trips aggregated by day of week are visualized.The first four graph are normal, the last four graphs are color vision defiency.

In Figure (a), during a week, there is a peak of average duration around at 15pm while a trough at 6am. Also, on weekends, even on Monday, people would like not to travel with a long duration during the whole day. As for Figure (b), it seems that there is a common trend for every day of a week. Besides, the obvious peak appears around 4am and after that, the average trip distance decline sharply to a quite low value and keep stable until next day’s 4am comes again. In Figure (c), each weekday also has a relatively same trend while weekends come with a little difference. Beside same peak and trough as Figure (b), what more interesting is that, the hourly average travel speed has a quite similar pattern with hourly average trip distance, but with a slightly large variance among each day of week. For Figure (d), it looks like that, hourly pickups has an opposite trend compared with average travel speed and average trip distance. Where hourly pickups has a peak, other two plots have a trough and vice versa. Another thing, that might be interesting is, weekdays seems have a similar trend as weekends, but with a time lag of approximately 3 hours. To make this point clearer, statistics aggregated by weekdays and weekends are shown in Figure (e).

library(viridis)

ggplot(clean_df, aes(x = pickup_longitude, y = pickup_latitude)) +
  geom_point(alpha = 0.1,size = 0.1) + 
  ggtitle("Pick Up Location")+
  geom_hex(bins=80)+
  scale_fill_distiller(palette = 'Spectral')+
  xlab('')+ylab('')

ggplot(clean_df, aes(pickup_longitude, pickup_latitude)) + stat_density_2d(aes(fill = ..level..), geom = "polygon",contour = TRUE)

Form heatmap, point graph,and 2d Kernel density graph, we can easy find that most taixes pick up on John F. Kennedy International Airport, LaGuardia Airport (LGA) and Mahatten expect up town. Also the highes density for taxies picking up passanger is at Midtown in Mahattan.

5.1 Univariate Distributions

After cleaning the raw data, applying the carefully designed rules to filtering out 13.04% erroneous records (Section 4.1) and deriving key metrics, we visualized the univariate distributions of each metric that is of our interest. Particularly, we have the following findings, which is reflected by Figure 1.

1. Travel Distance
   1. Most people in NYC travel less than 3 miles by taxi
   2. Seldem do people tavel more than 10 miles by taxi but these things do happen.
2. Trip Duration
   1. In most time, a taxi trip takes less than 15 minutes.
   2. Seldem do people need a taxi ride of more than 30 minutes.
3. Speed of taxi
   1. In most cases, you can expect your taxi running around 10 miles per hour in the city
   2. You can seldom run more than 30 miles per hour taking a taxi.
4. A reasonable cost for every mile you travel by taxi is $3-$9
5. When taking a taxi, you should expect to travel no more than twice as much distance as you fly directly from your origin to your destination.

Figure 1 Univariate distributions of important metrics

5.2 Temporal Travel Patterns

Looking at the time series plot for number of taxi trips (Figure 2), we find a clear pattern of daily periodicity. For some of the days in this plot, we noticed a clear bimodality. We inspect this bimodality property futher and explain it in detail in Figure 4.

Figure 2 Number of taxi trips in a typical week

Figure 3 uncovers the variations of number of taxi trips by day of week. Specifically, we have the following conclusion:

1. Tuesday to Friday are traffic-heavy days, whereras Saturday, Sunday and Monday are relatively less busy.
2. Friday has the heaviest traffic in a week.

Figure 3 Average daily number of taxi trips by day of week

Inspired by the daily variations discovered above, we jonitly explore the multi modaliy, daily periodicity, and variations by day of week. Different metrics are visualized in Figure 4.

Figure 4 Key metrics distributed in 24 hour

We summarise our findings below.

1. In the morining (8:00 - 13:00), average trip duration on weekends deviates from those on weekdays (Figure 4 (a)). This is possibly due to the fact that less vehicles are traveling on the roads on weekend morinings. This can be jointly verified by comparing (a) and (c) in Figure 4. As is shown by (c), the average travel speeds on weekend mornings are obviously higher than those on weekends.
2. In general, taxis can run faster on weekends (Figure 4 (c)) and taxi trips take less time on weekends than on weekdays (Fiure 4 (a)). This suggests that traffic conditions on weekends are generally better on weekends than on weekdays.
3. Travel speed and travel distance both reach their peaks at around 5:00 am. This is the time when people drive fast and travel long. We hypothesize that this is due to the fact that people need to hurry to the airports for their morning flights.
4. During business hours (8:00 - 18:00), the average travel speed steadies in between 9-12 mph. Specially, Tuesday, Wednesday and Thursday have relatively worse traffic condition, whereas weekends have better traffic condition.
5. The speed curves of Saturday and Sunday in Figure 4 (c) are more smooth than those of weekdays. This is another evidence that traffic conditions are better on weekends.
   
6. It looks like that, hourly pickups has an opposite trend compared with average travel speed and average trip distance. Where hourly pickups has a peak, other two plots have a trough and vice versa. This suggests a check for negative correlation. We did this in the next subsection.
7. 8:00 am is the morning rush hour on weekdays. However, there is no morning rush hour on weekends. This is shown by Figure 4 (d), the number of taxi trips peak at 8:00 am on weekdays, whereas on weekends the curves are smooth with no morning peak.
8. 18:00 - 19:00 is the busiest and most taxi-demanding hours of all days. Together with mornig rush hours, they form the two modes in Figure 4 (d). This observation of bimodality aligns with our domain knowledge in transportation engineering and urban planning.
9. New York is a city that never sleeps! In particular, the number of taxi trips keeps at a high level from 18:00 - 2:00 am on weekends, mainly becaus of New Yorkers’ rich nightlife.

Figure 5 provides a better visualization that uncovers the difference of people’s traveling behavior between weekdays and weekends. Conclusion 7, 8 and 9 is more clearly reflected by this figure. What’s more, the number of taxi trips on weekends seems to have a similar trend as that on weekdays, but with a time lag of approximately 4 hours. We hypothesize that this phenomenon is due to the fact that people get up late on weekends.

Figure 5 Hourly pikcked up person counts by weekdays and weekends

5.3 Correlations

Inspired by finding 6 in section 5.3, we further inspect the correlations among key variables. We summarise our exploration results as follow

1. Price is strongly linearly correlated with trip distance. We can expect very good result if we fit Price ~ + Trip_distance
2. Speed has a positive correlation with trip distance
3. Average speed on weekdays is slower but average price is higher.
4. Price is positively correlated with speed

Figure 6 Correlation Matrix

5.4 Spatial Patterns

Explored the spatial distribution patterns of taxi trips. Figure 7 plots the overall taxi trip density in 2016-01. Specially, two isolated clusters stand out (top right and bottom right). The top right cluster is found out to be Laguardia Airpot and the bottom right is JFK airpot.

Figure 7 2d density plot with contours

Furthermore, we took a closer look at Manhattan and found 3 hot spots standing out from other regions, namely Times Square, Pen Station, and the Empire State Building (Figure 8)

Figure 8 Hot Spots

5.5 Temporal-Spatial Visualization

To get a better sense of the temporal-spatial patterns of taxi trips, we visualize the heat map dynamically for a typical 24 hour (Figure 9).

Figure 9 Dynamic heat map for a typical 24 hours

6.1 Interactive Visualization Presentation

6.2 Descriptions for Interactive Visualization

/* Average area pickup frequency */

SELECT 
  row_number() over() as cartodb_id,
  ROUND((ts.num_pickups/tz.shape_area)::numeric,2)as avg_area_pickups,
  ts.num_pickups,
  tz.zone,
  tz.borough as Borough,
  tz.the_geom as the_geom,
  tz.the_geom_webmercator
FROM
  (SELECT * FROM nyc_taxi) AS tz
  INNER JOIN
  (SELECT pulocationid,
   count(*) as num_pickups 
   FROM taxi_sample_2017_12_cleaned
   group by pulocationid
  ) AS ts
ON tz.locationid = ts.pulocationid;

/* Average area fare amount */

SELECT 
  row_number() over() as cartodb_id,
  ts.average_fare,
  tz.zone,
  tz.borough as borough,
  tz.the_geom as the_geom,
  tz.the_geom_webmercator
FROM
  (SELECT * FROM nyc_taxi) AS tz
  INNER JOIN
  (SELECT pulocationid,
   ROUND(AVG(total_amount)::numeric,2) as average_fare 
   FROM taxi_sample_2017_12_cleaned
   group by pulocationid
  ) AS ts
ON tz.locationid = ts.pulocationid;

/* Average area duration */

SELECT 
  row_number() over() as cartodb_id,
  ts.average_duration,
  tz.zone,
  tz.borough as borough,
  tz.the_geom as the_geom,
  tz.the_geom_webmercator
FROM
  (SELECT * FROM nyc_taxi) AS tz
  INNER JOIN
  (SELECT pulocationid,
   ROUND(AVG(Duration)::numeric,2) as average_duration 
   FROM taxi_sample_2017_12_cleaned
   group by pulocationid
  ) AS ts
ON tz.locationid = ts.pulocationid;

/* Average area distance */

SELECT 
  row_number() over() as cartodb_id,
  ts.average_distance,
  tz.zone,
  tz.borough as borough,
  tz.the_geom as the_geom,
  tz.the_geom_webmercator
FROM
  (SELECT * FROM nyc_taxi) AS tz
  INNER JOIN
  (SELECT pulocationid,
   ROUND(AVG(trip_distance)::numeric,2) as average_distance 
   FROM taxi_sample_2017_12_cleaned
   group by pulocationid
  ) AS ts
ON tz.locationid = ts.pulocationid;


/* Average area speed */

SELECT 
  row_number() over() as cartodb_id,
  ts.average_speed,
  tz.zone,
  tz.borough as borough,
  tz.the_geom as the_geom,
  tz.the_geom_webmercator
FROM
  (SELECT * FROM nyc_taxi) AS tz
  INNER JOIN
  (SELECT pulocationid,
   ROUND(AVG(Average_speed)::numeric,2) as average_speed 
   FROM taxi_sample_2017_12_cleaned
   group by pulocationid
  ) AS ts
ON tz.locationid = ts.pulocationid;

/* Average area Fare_rate */

SELECT 
  row_number() over() as cartodb_id,
  ts.average_fare_rate,
  tz.zone,
  tz.borough as borough,
  tz.the_geom as the_geom,
  tz.the_geom_webmercator
FROM
  (SELECT * FROM nyc_taxi) AS tz
  INNER JOIN
  (SELECT pulocationid,
   ROUND(AVG(Fare_rate)::numeric,2) as average_fare_rate 
   FROM taxi_sample_2017_12_cleaned
   group by pulocationid
  ) AS ts
ON tz.locationid = ts.pulocationid;


/*Time Series Plot*/
select *,
  row_number() over() as cartodb_id,
  ST_SetSRID(ST_Makepoint(longitude,latitude),4326) as the_geom,
  ST_Transform(ST_SetSRID(ST_Makepoint(longitude,latitude),4326),3857) as the_geom_webmercator
from 
 (SELECT 
      cartodb_id as trip_id, 
      payment_type,
      passenger_count,
      total_amount,
      trip_distance,
      unnest(array['pickup','dropoff' ]) AS ttype,
      unnest(array[pickup_longitude,dropoff_longitude]) as longitude,
      unnest(array[pickup_latitude,dropoff_latitude]) as latitude,
      unnest(array[pickup_datetime,dropoff_datetime]) as datetime,
      round(extract(EPOCH from (dropoff_datetime - pickup_datetime))/60) as duration
  FROM taxi_sample_2016
  order by trip_id
  ) as G
 where longitude between -74.052 and -73.744 and 
 latitude between 40.57 and 40.88 and
 datetime between 
 to_timestamp('2016-01-01','YYYY-MM-DD') and to_timestamp('2016-01-02','YYYY-MM-DD');